home *** CD-ROM | disk | FTP | other *** search
/ Tech Win 1995 November / CD [TECH_B].bin / tech_b / delphi / trial / disk4 / doc.pak / CLASSES.INT < prev    next >
Encoding:
Text File  |  1995-08-08  |  16.3 KB  |  490 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi Visual Component Library                 }
  4. {                                                       }
  5. {       Copyright (c) 1995 Borland International        }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit Classes;
  10.  
  11. {$N+,P+,R-,S-,W-}
  12. {$C PRELOAD}
  13.  
  14. interface
  15.  
  16. uses SysUtils, WinTypes, WinProcs;
  17.  
  18. const
  19.  
  20. { Maximum TList size }
  21.  
  22.   MaxListSize = 65520 div SizeOf(Pointer);
  23.  
  24. { TStream seek origins }
  25.  
  26.   soFromBeginning = 0;
  27.   soFromCurrent = 1;
  28.   soFromEnd = 2;
  29.  
  30. { TFileStream create mode }
  31.  
  32.   fmCreate = $FFFF;
  33.  
  34. { TParser special tokens }
  35.  
  36.   toEOF     = Char(0);
  37.   toSymbol  = Char(1);
  38.   toString  = Char(2);
  39.   toInteger = Char(3);
  40.   toFloat   = Char(4);
  41.  
  42. type
  43.  
  44. { Text alignment types }
  45.  
  46.   TAlignment = (taLeftJustify, taRightJustify, taCenter);
  47.   TLeftRight = taLeftJustify..taRightJustify;
  48.  
  49. { Types used by standard events }
  50.  
  51.   TShiftState = set of (ssShift, ssAlt, ssCtrl,
  52.     ssLeft, ssRight, ssMiddle, ssDouble);
  53.  
  54.   THelpContext = -MaxLongint..MaxLongint;
  55.  
  56. { Standard events }
  57.  
  58.   TNotifyEvent = procedure(Sender: TObject) of object;
  59.   THelpEvent = function (Command: Word; Data: Longint;
  60.     var CallHelp: Boolean): Boolean of object;
  61.   TGetStrProc = procedure(const S: string) of object;
  62.  
  63. { Exception classes }
  64.  
  65.   EStreamError = class(Exception);
  66.   EFCreateError = class(EStreamError);
  67.   EFOpenError = class(EStreamError);
  68.   EFilerError = class(EStreamError);
  69.   EReadError = class(EFilerError);
  70.   EWriteError = class(EFilerError);
  71.   EClassNotFound = class(EFilerError);
  72.   EMethodNotFound = class(EFilerError);
  73.   EInvalidImage = class(EFilerError);
  74.   EResNotFound = class(Exception);
  75.   EListError = class(Exception);
  76.   EStringListError = class(Exception);
  77.   EComponentError = class(Exception);
  78.   EParserError = class(Exception);
  79.  
  80. { Forward class declarations }
  81.  
  82.   TStream = class;
  83.   TFiler = class;
  84.   TReader = class;
  85.   TWriter = class;
  86.   TComponent = class;
  87.  
  88. { TList class }
  89.  
  90.   PPointerList = ^TPointerList;
  91.   TPointerList = array[0..MaxListSize - 1] of Pointer;
  92.  
  93.   TList = class(TObject)
  94.   protected
  95.     procedure Error; virtual;
  96.     function Get(Index: Integer): Pointer;
  97.     procedure Grow; virtual;
  98.     procedure Put(Index: Integer; Item: Pointer);
  99.     procedure SetCapacity(NewCapacity: Integer);
  100.     procedure SetCount(NewCount: Integer);
  101.   public
  102.     destructor Destroy; override;
  103.     function Add(Item: Pointer): Integer;
  104.     procedure Clear;
  105.     procedure Delete(Index: Integer);
  106.     procedure Exchange(Index1, Index2: Integer);
  107.     function Expand: TList;
  108.     function First: Pointer;
  109.     function IndexOf(Item: Pointer): Integer;
  110.     procedure Insert(Index: Integer; Item: Pointer);
  111.     function Last: Pointer;
  112.     procedure Move(CurIndex, NewIndex: Integer);
  113.     function Remove(Item: Pointer): Integer;
  114.     procedure Pack;
  115.     property Capacity: Integer;
  116.     property Count: Integer;
  117.     property Items[Index: Integer]: Pointer; default;
  118.     property List: PPointerList;
  119.   end;
  120.  
  121. { TPersistent abstract class }
  122.  
  123. {$M+}
  124.  
  125.   TPersistent = class(TObject)
  126.   protected
  127.     procedure AssignTo(Dest: TPersistent); virtual;
  128.     procedure DefineProperties(Filer: TFiler); virtual;
  129.   public
  130.     procedure Assign(Source: TPersistent); virtual;
  131.   end;
  132.  
  133. {$M-}
  134.  
  135. { TPersistent class reference type }
  136.  
  137.   TPersistentClass = class of TPersistent;
  138.  
  139. { TStrings class }
  140.  
  141.   TStrings = class(TPersistent)
  142.   protected
  143.     procedure DefineProperties(Filer: TFiler); override;
  144.     function Get(Index: Integer): string; virtual; abstract;
  145.     function GetCount: Integer; virtual; abstract;
  146.     function GetObject(Index: Integer): TObject; virtual;
  147.     procedure Put(Index: Integer; const S: string); virtual;
  148.     procedure PutObject(Index: Integer; AObject: TObject); virtual;
  149.     procedure SetUpdateState(Updating: Boolean); virtual;
  150.   public
  151.     function Add(const S: string): Integer; virtual;
  152.     function AddObject(const S: string; AObject: TObject): Integer; virtual;
  153.     procedure AddStrings(Strings: TStrings); virtual;
  154.     procedure Assign(Source: TPersistent); override;
  155.     procedure BeginUpdate;
  156.     procedure Clear; virtual; abstract;
  157.     procedure Delete(Index: Integer); virtual; abstract;
  158.     procedure EndUpdate;
  159.     function Equals(Strings: TStrings): Boolean;
  160.     procedure Exchange(Index1, Index2: Integer); virtual;
  161.     function GetText: PChar; virtual;
  162.     function IndexOf(const S: string): Integer; virtual;
  163.     function IndexOfObject(AObject: TObject): Integer;
  164.     procedure Insert(Index: Integer; const S: string); virtual; abstract;
  165.     procedure InsertObject(Index: Integer; const S: string;
  166.       AObject: TObject);
  167.     procedure LoadFromFile(const FileName: string);
  168.     procedure LoadFromStream(Stream: TStream); virtual;
  169.     procedure Move(CurIndex, NewIndex: Integer); virtual;
  170.     procedure SaveToFile(const FileName: string);
  171.     procedure SaveToStream(Stream: TStream); virtual;
  172.     procedure SetText(Text: PChar); virtual;
  173.     property Count: Integer;
  174.     property Objects[Index: Integer]: TObject;
  175.     property Values[const Name: string]: string;
  176.     property Strings[Index: Integer]: string; default;
  177.   end;
  178.  
  179. { TStringList class }
  180.  
  181.   TDuplicates = (dupIgnore, dupAccept, dupError);
  182.  
  183.   TStringList = class(TStrings)
  184.   protected
  185.     procedure Changed; virtual;
  186.     procedure Changing; virtual;
  187.     function Get(Index: Integer): string; override;
  188.     function GetCount: Integer; override;
  189.     function GetObject(Index: Integer): TObject; override;
  190.     procedure Put(Index: Integer; const S: string); override;
  191.     procedure PutObject(Index: Integer; AObject: TObject); override;
  192.     procedure SetUpdateState(Updating: Boolean); override;
  193.   public
  194.     constructor Create;
  195.     destructor Destroy; override;
  196.     function Add(const S: string): Integer; override;
  197.     procedure Clear; override;
  198.     procedure Delete(Index: Integer); override;
  199.     procedure Exchange(Index1, Index2: Integer); override;
  200.     function Find(const S: string; var Index: Integer): Boolean; virtual;
  201.     function IndexOf(const S: string): Integer; override;
  202.     procedure Insert(Index: Integer; const S: string); override;
  203.     procedure Sort; virtual;
  204.     property Duplicates: TDuplicates;
  205.     property Sorted: Boolean;
  206.     property OnChange: TNotifyEvent;
  207.     property OnChanging: TNotifyEvent;
  208.   end;
  209.  
  210. { TStream abstract class }
  211.  
  212.   TStream = class(TObject)
  213.   public
  214.     function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
  215.     function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
  216.     function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
  217.     procedure ReadBuffer(var Buffer; Count: Longint);
  218.     procedure WriteBuffer(const Buffer; Count: Longint);
  219.     function CopyFrom(Source: TStream; Count: Longint): Longint;
  220.     function ReadComponent(Instance: TComponent): TComponent;
  221.     function ReadComponentRes(Instance: TComponent): TComponent;
  222.     procedure WriteComponent(Instance: TComponent);
  223.     procedure WriteComponentRes(const ResName: string; Instance: TComponent);
  224.     procedure ReadResHeader;
  225.     property Position: Longint;
  226.     property Size: Longint;
  227.   end;
  228.  
  229. { THandleStream class }
  230.  
  231.   THandleStream = class(TStream)
  232.   public
  233.     constructor Create(AHandle: Integer);
  234.     function Read(var Buffer; Count: Longint): Longint; override;
  235.     function Write(const Buffer; Count: Longint): Longint; override;
  236.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  237.     property Handle: Integer;
  238.   end;
  239.  
  240. { TFileStream class }
  241.  
  242.   TFileStream = class(THandleStream)
  243.   public
  244.     constructor Create(const FileName: string; Mode: Word);
  245.     destructor Destroy; override;
  246.   end;
  247.  
  248. { TMemoryStream }
  249.  
  250.   TMemoryStream = class(TStream)
  251.   public
  252.     destructor Destroy; override;
  253.     function Read(var Buffer; Count: Longint): Longint; override;
  254.     function Write(const Buffer; Count: Longint): Longint; override;
  255.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  256.     procedure LoadFromStream(Stream: TStream);
  257.     procedure LoadFromFile(const FileName: string);
  258.     procedure SaveToStream(Stream: TStream);
  259.     procedure SaveToFile(const FileName: string);
  260.     procedure SetSize(Size: Longint);
  261.     procedure Clear;
  262.     property Memory: Pointer;
  263.   end;
  264.  
  265. { TFiler }
  266.  
  267.   TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
  268.     vaString, vaIdent, vaFalse, vaTrue, vaBinary, vaSet);
  269.  
  270.   TReaderProc = procedure(Reader: TReader) of object;
  271.   TWriterProc = procedure(Writer: TWriter) of object;
  272.   TStreamProc = procedure(Stream: TStream) of object;
  273.  
  274.   TFiler = class(TObject)
  275.   public
  276.     constructor Create(Stream: TStream; BufSize: Cardinal);
  277.     destructor Destroy; override;
  278.     procedure DefineProperty(const Name: string;
  279.       ReadData: TReaderProc; WriteData: TWriterProc;
  280.       HasData: Boolean); virtual; abstract;
  281.     procedure DefineBinaryProperty(const Name: string;
  282.       ReadData, WriteData: TStreamProc;
  283.       HasData: Boolean); virtual; abstract;
  284.     property Root: TComponent;
  285.   end;
  286.  
  287. { TReader }
  288.  
  289.   TFindMethodEvent = procedure(Reader: TReader; const MethodName: string;
  290.     var Address: Pointer; var Error: Boolean) of object;
  291.   TSetNameEvent = procedure(Reader: TReader; Component: TComponent;
  292.     var Name: string) of object;
  293.   TReadComponentsProc = procedure(Component: TComponent) of object;
  294.   TReaderError = procedure(Reader: TReader; const Message: string; var Handled: Boolean) of object;
  295.  
  296.   TReader = class(TFiler)
  297.   protected
  298.     function Error(const Message: string): Boolean; virtual;
  299.     function FindMethod(Root: TComponent; const MethodName: string): Pointer; virtual;
  300.     procedure SetName(Component: TComponent; var Name: string); virtual;
  301.   public
  302.     destructor Destroy; override;
  303.     procedure DefineProperty(const Name: string;
  304.       ReadData: TReaderProc; WriteData: TWriterProc;
  305.       HasData: Boolean); override;
  306.     procedure DefineBinaryProperty(const Name: string;
  307.       ReadData, WriteData: TStreamProc;
  308.       HasData: Boolean); override;
  309.     function EndOfList: Boolean;
  310.     procedure Read(var Buf; Count: Longint);
  311.     function ReadBoolean: Boolean;
  312.     function ReadChar: Char;
  313.     procedure ReadComponents(AOwner, AParent: TComponent;
  314.       Proc: TReadComponentsProc);
  315.     function ReadFloat: Extended;
  316.     function ReadIdent: string;
  317.     function ReadInteger: Longint;
  318.     procedure ReadListBegin;
  319.     procedure ReadListEnd;
  320.     function ReadRootComponent(Root: TComponent): TComponent;
  321.     procedure ReadSignature;
  322.     function ReadStr: string;
  323.     function ReadString: string;
  324.     property Owner: TComponent;
  325.     property Parent: TComponent;
  326.     property OnError: TReaderError;
  327.     property OnFindMethod: TFindMethodEvent;
  328.     property OnSetName: TSetNameEvent;
  329.   end;
  330.  
  331. { TWriter }
  332.  
  333.   TWriter = class(TFiler)
  334.   public
  335.     destructor Destroy; override;
  336.     procedure DefineProperty(const Name: string;
  337.       ReadData: TReaderProc; WriteData: TWriterProc;
  338.       HasData: Boolean); override;
  339.     procedure DefineBinaryProperty(const Name: string;
  340.       ReadData, WriteData: TStreamProc;
  341.       HasData: Boolean); override;
  342.     procedure Write(const Buf; Count: Longint);
  343.     procedure WriteBoolean(Value: Boolean);
  344.     procedure WriteComponent(Component: TComponent);
  345.     procedure WriteChar(Value: Char);
  346.     procedure WriteFloat(Value: Extended);
  347.     procedure WriteIdent(const Ident: string);
  348.     procedure WriteInteger(Value: Longint);
  349.     procedure WriteListBegin;
  350.     procedure WriteListEnd;
  351.     procedure WriteRootComponent(Root: TComponent);
  352.     procedure WriteSignature;
  353.     procedure WriteStr(const Value: string);
  354.     procedure WriteString(const Value: string);
  355.   end;
  356.  
  357. { TParser }
  358.  
  359.   TParser = class(TObject)
  360.   public
  361.     constructor Create(Stream: TStream);
  362.     destructor Destroy; override;
  363.     procedure CheckToken(T: Char);
  364.     procedure CheckTokenSymbol(const S: string);
  365.     procedure Error(MessageID: Word);
  366.     procedure ErrorStr(const Message: string);
  367.     procedure HexToBinary(Stream: TStream);
  368.     function NextToken: Char;
  369.     function SourcePos: Longint;
  370.     function TokenFloat: Extended;
  371.     function TokenInt: Longint;
  372.     function TokenString: string;
  373.     function TokenSymbolIs(const S: string): Boolean;
  374.     property SourceLine: Integer;
  375.     property Token: Char;
  376.   end;
  377.  
  378. { TComponent class }
  379.  
  380.   TOperation = (opInsert, opRemove);
  381.   TComponentState = set of (csLoading, csReading, csWriting, csDestroying,
  382.     csDesigning);
  383.  
  384.   TComponentName = string[63];
  385.  
  386.   TComponent = class(TPersistent)
  387.   protected
  388.     procedure ChangeName(const NewName: TComponentName);
  389.     procedure DefineProperties(Filer: TFiler); override;
  390.     function HasParent: Boolean; virtual;
  391.     procedure Loaded; virtual;
  392.     procedure Notification(AComponent: TComponent;
  393.       Operation: TOperation); virtual;
  394.     procedure ReadState(Reader: TReader); virtual;
  395.     procedure SetDesigning(Value: Boolean);
  396.     procedure SetName(const NewName: TComponentName); virtual;
  397.     procedure ValidateRename(AComponent: TComponent;
  398.       const CurName, NewName: string); virtual;
  399.     procedure WriteComponents(Writer: TWriter); virtual;
  400.     procedure WriteState(Writer: TWriter); virtual;
  401.   public
  402.     constructor Create(AOwner: TComponent); virtual;
  403.     destructor Destroy; override;
  404.     procedure DestroyComponents;
  405.     procedure Destroying;
  406.     function FindComponent(const AName: string): TComponent;
  407.     procedure InsertComponent(AComponent: TComponent);
  408.     procedure RemoveComponent(AComponent: TComponent);
  409.     property Components[Index: Integer]: TComponent;
  410.     property ComponentCount: Integer;
  411.     property ComponentIndex: Integer;
  412.     property ComponentState: TComponentState;
  413.     property DesignInfo: Longint;
  414.     property Owner: TComponent;
  415.   published
  416.     property Name: TComponentName;
  417.     property Tag: Longint default 0;
  418.   end;
  419.  
  420. { TComponent class reference type }
  421.  
  422.   TComponentClass = class of TComponent;
  423.  
  424. { Component registration handlers }
  425.  
  426. const
  427.   RegisterComponentsProc: procedure(const Page: string;
  428.     ComponentClasses: array of TComponentClass) = nil;
  429.   RegisterNoIconProc: procedure(ComponentClasses: array of TComponentClass) = nil;
  430.  
  431. { Point and rectangle constructors }
  432.  
  433. function Point(AX, AY: Integer): TPoint;
  434. function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
  435. function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
  436.  
  437. { Class registration routines }
  438.  
  439. procedure RegisterClass(AClass: TPersistentClass);
  440. procedure RegisterClasses(AClasses: array of TPersistentClass);
  441. procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
  442. procedure UnRegisterClass(AClass: TPersistentClass);
  443. procedure UnRegisterClasses(AClasses: array of TPersistentClass);
  444. function FindClass(const ClassName: string): TPersistentClass;
  445. function GetClass(const ClassName: string): TPersistentClass;
  446.  
  447. { Component registration routines }
  448.  
  449. procedure RegisterComponents(const Page: string;
  450.   ComponentClasses: array of TComponentClass);
  451. procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
  452.  
  453. { Object filing routines }
  454.  
  455. type
  456.   TIdentToInt = function (const Ident: string; var Int: Longint): Boolean;
  457.   TIntToIdent = function (Int: Longint; var Ident: string): Boolean;
  458.  
  459. procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToInt: TIdentToInt;
  460.   IntToIdent: TIntToIdent);
  461. function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
  462. function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
  463. procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
  464.  
  465. { Object conversion routines }
  466.  
  467. procedure ObjectBinaryToText(Input, Output: TStream);
  468. procedure ObjectTextToBinary(Input, Output: TStream);
  469.  
  470. procedure ObjectResourceToText(Input, Output: TStream);
  471. procedure ObjectTextToResource(Input, Output: TStream);
  472.  
  473. { Utility routines }
  474.  
  475. function LineStart(Buffer, BufPos: PChar): PChar;
  476.  
  477. { StrItem management, shared by TStringList and TStringSparseList }
  478.  
  479. type
  480.   PStrItem = ^TStrItem;
  481.   TStrItem = record
  482.     FObject: TObject;
  483.     FString: string;
  484.   end;
  485.  
  486. function NewStrItem(const AString: string; AObject: TObject): PStrItem;
  487. procedure DisposeStrItem(P: PStrItem);
  488.  
  489. implementation
  490.